home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / ChipCD_1.03.iso / zkuste / delphi / kolekce / d3456 / GmPrintSuite_2_61_Lite.exe / {app} / GmGridPrint.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-10-05  |  14.1 KB  |  410 lines
  1. {******************************************************************************}
  2. {                                                                              }
  3. {                        GmGridPrint.pas v2.61 Pro                             }
  4. {                                                                              }
  5. {           Copyright (c) 2001 Graham Murt  - www.MurtSoft.co.uk               }
  6. {                                                                              }
  7. {   Feel free to e-mail me with any comments, suggestions, bugs or help at:    }
  8. {                                                                              }
  9. {                           graham@murtsoft.co.uk                              }
  10. {                                                                              }
  11. {******************************************************************************}
  12.  
  13. unit GmGridPrint;
  14.  
  15. interface
  16.  
  17.   {$I GMPS.INC}
  18.  
  19. uses
  20.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  21.   GmPreview, GmTypes, grids, GmCanvas;
  22.  
  23. type
  24.   TGmDrawCellEvent        = procedure (Sender: TObject; AGrid: TDrawGrid; Col, Row: Longint; ARect: TGmValueRect; ACanvas: TGmCanvas) of object;
  25.   TGetCellAlignmentEvent  = procedure (Sender: TObject; AGrid: TDrawGrid; Col, Row: Longint; var Alignment: TAlignment; var VertAlignment: TGmVertAlignment) of object;
  26.   TGridNewPageEvent       = procedure (Sender: TObject; var ATopMargin, ABottomMargin: TGmValue) of object;
  27.  
  28.  
  29.   TGmColWidth = class
  30.   private
  31.     FColumn : integer;
  32.     FWidth  : integer;                  
  33.   public
  34.     property Column: integer read FColumn write FColumn;
  35.     property Width: integer read FWidth write FWidth;
  36.   end;
  37.  
  38.   TGmColWidthList = class(TList)
  39.   private
  40.     FScale: Extended;
  41.     function GetColWidth(ACol: integer): TGmColWidth;
  42.     function GetTotalWidth: integer;
  43.     procedure SetColWidth(ACol: integer; Value: TGmColWidth);
  44.   public
  45.     procedure AddColWidth(ACol, AWidth: integer);
  46.     procedure Clear; {$IFDEF D4+} override; {$ENDIF}
  47.     property ColWidth[ACol: integer]: TGmColWidth read GetColWidth write SetColWidth; default;
  48.     property Scale: Extended read FScale write FScale;
  49.     property TotalWidth: integer read GetTotalWidth;
  50.   end;
  51.  
  52.   TGmGridOption = (gmVertLine, gmHorzLine, gmFixedRowPerPage);
  53.   TGmGridOptions = set of TGmGridOption;
  54.  
  55.   TGmGridPrint = class(TGmCustomGridPrint)
  56.   private
  57.     FMonochrome: Boolean;
  58.     FColWidths: TGmColWidthList;
  59.     FDefaultCellAlign: TAlignment;
  60.     FDefaultCellVertAlign: TGmVertAlignment;
  61.     FGridOptions: TGmGridOptions;
  62.     FPreview: TGmPreview;
  63.     FScaleText: Boolean;
  64.     FTopMargin: TGmValue;
  65.     FBottomMargin: TGmValue;
  66.     // events...
  67.     FOnDrawCell: TGmDrawCellEvent;
  68.     FOnGetCellAlignment: TGetCellAlignmentEvent;
  69.     FOnGridNewPage: TGridNewPageEvent;
  70.     function GetCellRect(AGrid: TDrawGrid; CurrLeft, CurrTop, ACol, ARow: integer): TRect;
  71.     procedure DefaultDrawCellExt(AGrid: TDrawGrid; ARect: TGmValueRect;
  72.       ACol, ARow: integer; Alignment: TAlignment; VertAlignment: TGmVertAlignment);
  73.     procedure DrawBottomLine(ARow: integer; AGrid: TDrawGrid; ALeft: integer; ATop: integer);
  74.     procedure DrawTopLine(ARow: integer; AGrid: TDrawGrid; ALeft: integer; ATop: integer);
  75.     procedure DrawGridRow(ARow: integer; AGrid: TDrawGrid; ALeft: integer; var ATop: integer);
  76.     procedure SetPreview(const Value: TGmPreview);
  77.     { Private declarations }
  78.   protected
  79.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  80.     { Protected declarations }
  81.   public
  82.     constructor Create(AOwner: TComponent); override;
  83.     destructor Destroy; override;
  84.     function IsFixedCell(AGrid: TDrawGrid; ACol, ARow: integer): Boolean;
  85.     procedure DefaultDrawCell(AGrid: TDrawGrid; ARect: TGmValueRect; ACol, ARow: integer);
  86.     procedure GridToPage(X, Y, AWidth: Extended; AUnits: TGmMeasurement;
  87.       AGrid: TDrawGrid);
  88.     property TopMargin: TGmValue read FTopMargin write FTopMargin;
  89.     property BottomMargin: TGmValue read FBottomMargin write FBottomMargin;
  90.     { Public declarations }
  91.   published
  92.     { Published declarations }
  93.     property DefaultCellAlignment: TAlignment read FDefaultCellAlign write FDefaultCellAlign default taLeftJustify;
  94.     property DefaultCellVertAlignment: TGmVertAlignment read FDefaultCellVertAlign write FDefaultCellVertAlign default gmTop;
  95.     property GridOptions: TGmGridOptions read FGridOptions write FGridOptions
  96.       default [gmVertLine, gmHorzLine, gmFixedRowPerPage];
  97.     property Monochrome: Boolean read FMonochrome write FMonochrome default False;
  98.     property Preview: TGmPreview read FPreview write SetPreview;
  99.     property ScaleText: Boolean read FScaleText write FScaleText default False;
  100.     // events...
  101.     property OnDrawCell: TGmDrawCellEvent read FOnDrawCell write FOnDrawCell;
  102.     property OnGetCellAlignment: TGetCellAlignmentEvent read FOnGetCellAlignment write FOnGetCellAlignment;
  103.     property OnGridNewPage: TGridNewPageEvent read FOnGridNewPage write FOnGridNewPage;
  104.   end;
  105.  
  106. implementation
  107.  
  108. uses GmErrors, Dialogs, GmConst, GmObjects;
  109.  
  110. //------------------------------------------------------------------------------
  111.  
  112. procedure TGmColWidthList.AddColWidth(ACol, AWidth: integer);
  113. var
  114.   NewColWidth: TGmColWidth;
  115. begin
  116.   NewColWidth := TGmColWidth.Create;
  117.   NewColWidth.Column := ACol;
  118.   NewColWidth.Width := AWidth;
  119.   Add(NewColWidth);
  120. end;
  121.  
  122. procedure TGmColWidthList.Clear;
  123. var
  124.   ICount: integer;
  125. begin
  126.   for ICount := Count-1 downto 0 do
  127.   begin
  128.     TGmColWidth(Self[ICount]).Free;
  129.   end;
  130.   {$IFDEF D4+}
  131.   inherited Clear;
  132.   {$ENDIF}
  133. end;
  134.  
  135. function TGmColWidthList.GetColWidth(ACol: integer): TGmColWidth;
  136. begin
  137.   Result := TGmColWidth(Items[ACol]);
  138. end;
  139.  
  140. function TGmColWidthList.GetTotalWidth: integer;
  141. var
  142.   ICount: integer;
  143. begin
  144.   Result := 0;
  145.   for ICount := 0 to Count-1 do
  146.     Inc(Result, ColWidth[ICount].Width);
  147. end;
  148.  
  149. procedure TGmColWidthList.SetColWidth(ACol: integer; Value: TGmColWidth);
  150. begin
  151.   Items[ACol] := Value;
  152. end;
  153.  
  154. //------------------------------------------------------------------------------
  155.  
  156. constructor TGmGridPrint.Create(AOwner: TComponent);
  157. begin
  158.   inherited Create(AOwner);
  159.   FColWidths := TGmColWidthList.Create;
  160.   FGridOptions := [gmVertLine, gmHorzLine, gmFixedRowPerPage];
  161.   FMonochrome := False;
  162.   FTopMargin    := TGmValue.CreateValue(3500);
  163.   FBottomMargin := TGmValue.CreateValue(3500);
  164.   FScaleText := False;
  165.   FDefaultCellAlign := taLeftJustify;
  166.   FDefaultCellVertAlign := gmTop;
  167. end;
  168.  
  169. destructor TGmGridPrint.Destroy;
  170. begin
  171.   // free TGmPrintSuite objects...
  172.   FTopMargin.Free;
  173.   FBottomMargin.Free;
  174.   FColWidths.Free;
  175.   inherited;
  176. end;
  177.  
  178. function TGmGridPrint.IsFixedCell(AGrid: TDrawGrid; ACol, ARow: integer): Boolean;
  179. begin
  180.   Result := (ACol < AGrid.FixedCols) or (ARow < AGrid.FixedRows);
  181. end;
  182.  
  183. procedure TGmGridPrint.DefaultDrawCell(AGrid: TDrawGrid; ARect: TGmValueRect; ACol, ARow: integer);
  184. begin
  185.   DefaultDrawCellExt(AGrid, ARect, ACol, ARow, FDefaultCellAlign, FDefaultCellVertAlign);
  186. end;
  187.  
  188. procedure TGmGridPrint.Notification(AComponent: TComponent; Operation: TOperation);
  189. begin
  190.   inherited Notification(AComponent, Operation);
  191.   if (Operation = opRemove) and (AComponent = FPreview) then
  192.     FPreview := nil;
  193. end;
  194.  
  195. procedure TGmGridPrint.DefaultDrawCellExt(AGrid: TDrawGrid; ARect: TGmValueRect;
  196.   ACol, ARow: integer; Alignment: TAlignment; VertAlignment: TGmVertAlignment);
  197. var
  198.   FontSize: integer;
  199.   CellAlign: TAlignment;
  200.   CellVertAlign: TGmVertAlignment;
  201. begin
  202.   CellAlign := Alignment;
  203.   CellVertAlign := VertAlignment;
  204.   if Assigned(FOnGetCellAlignment) then FOnGetCellAlignment(Self, AGrid, ACol, ARow, CellAlign, CellVertAlign);
  205.  
  206.   with FPreview.Canvas do
  207.   begin
  208.     if not FMonochrome then
  209.     begin
  210.       Rectangle(ARect.Left.AsUnits,
  211.                 ARect.Top.AsUnits,
  212.                 ARect.Right.AsUnits,
  213.                 ARect.Bottom.AsUnits,
  214.                 GmUnits);
  215.     end;
  216.     if (AGrid is TStringGrid) then
  217.     begin
  218.       Pen.Style := psClear;
  219.       Brush.Style := bsClear;
  220.       FontSize := Font.Size;
  221.       Font.Size := AGrid.Font.Size;
  222.       if FScaleText then Font.Size := Round(FColWidths.Scale * Font.Size);
  223.       try
  224.         TextBoxExt(ARect.Left.AsUnits+50, // 0.5 mm margin
  225.                    ARect.Top.AsUnits+50,
  226.                    ARect.Right.AsUnits-50, // 0.5 mm margin
  227.                    ARect.Bottom.AsUnits-50,
  228.                    TStringGrid(AGrid).Cells[ACol, ARow],
  229.                    CellAlign,
  230.                    CellVertAlign,
  231.                    True,
  232.                    GmUnits);
  233.         TGmTextBoxObject(LastObject).WordBreak := False;
  234.       finally
  235.         Font.Size := FontSize;
  236.       end;
  237.     end;
  238.     Pen.Style := psSolid;
  239.   end;
  240. end;
  241.  
  242. function TGmGridPrint.GetCellRect(AGrid: TDrawGrid; CurrLeft, CurrTop, ACol, ARow: integer): TRect;
  243. begin
  244.   Result.Left   := CurrLeft;
  245.   Result.Top    := CurrTop;
  246.   Result.Right  := CurrLeft + FColWidths[ACol].Width;
  247.   Result.Bottom := CurrTop  + Round(ConvertValue(AGrid.RowHeights[ARow], GmPixels, GmUnits));
  248. end;
  249.  
  250. procedure TGmGridPrint.DrawBottomLine(ARow: integer; AGrid: TDrawGrid; ALeft: integer; ATop: integer);
  251. var
  252.   ICount: integer;
  253.   ARect: TRect;
  254. begin
  255.   for ICount := 0 to AGrid.ColCount-1 do
  256.   begin
  257.     ARect := GetCellRect(AGrid, ALeft, ATop, ICount, ARow);
  258.     FPreview.Canvas.Pen.Style := psSolid;
  259.     FPreview.Canvas.Line(ARect.Left, ARect.Bottom, ARect.Right, ARect.Bottom, GmPixels);
  260.     Inc(ALeft, FColWidths[ICount].Width);
  261.   end;
  262. end;
  263.  
  264. procedure TGmGridPrint.DrawTopLine(ARow: integer; AGrid: TDrawGrid; ALeft: integer; ATop: integer);
  265. var
  266.   ICount: integer;
  267.   ARect: TRect;
  268. begin
  269.   for ICount := 0 to AGrid.ColCount-1 do
  270.   begin
  271.     ARect := GetCellRect(AGrid, ALeft, ATop, ICount, ARow);
  272.     FPreview.Canvas.Pen.Style := psSolid;
  273.     FPreview.Canvas.Line(ARect.Left, ARect.Top, ARect.Right, ARect.Top, GmPixels);
  274.     Inc(ALeft, FColWidths[ICount].Width);
  275.   end;
  276. end;
  277.  
  278. procedure TGmGridPrint.DrawGridRow(ARow: integer; AGrid: TDrawGrid; ALeft: integer; var ATop: integer);
  279. var
  280.   ICount: integer;
  281.   ARect: TRect;
  282.   AGmRect: TGmValueRect;
  283. begin
  284.   for ICount := 0 to AGrid.ColCount-1 do
  285.   begin
  286.     ARect := GetCellRect(AGrid, ALeft, ATop, ICount, ARow);
  287.  
  288.     FPreview.Canvas.Pen.Style := psSolid;
  289.     FPreview.Canvas.Pen.Color := clBlack;
  290.     FPreview.Canvas.Brush.Style := bsClear;
  291.  
  292.     // draw the grid's horizontal lines...
  293.     if (ARow = 0) or (gmHorzLine in FGridOptions) then
  294.       FPreview.Canvas.Line(ARect.Left, ARect.Top, ARect.Right, ARect.Top, GmUnits);
  295.  
  296.     // draw the grid's vertical lines...
  297.     if (ICount = 0) or (gmVertLine in FGridOptions) then
  298.       FPreview.Canvas.Line(ARect.Left, ARect.Top, ARect.Left, ARect.Bottom, GmUnits);
  299.  
  300.     // draw the right border...
  301.     if (ICount = AGrid.ColCount-1)  then
  302.       FPreview.Canvas.Line(ARect.Right, ARect.Top, ARect.Right, ARect.Bottom, GmUnits);
  303.     // draw the bottom border...
  304.     if ARow = AGrid.RowCount-1 then
  305.       FPreview.Canvas.Line(ARect.Left, ARect.Bottom, ARect.Right, ARect.Bottom, GmUnits);
  306.  
  307.     AGmRect := TGmValueRect.Create;
  308.     try
  309.       AGmRect.Left.AsUnits  := ARect.Left;
  310.       AGmRect.Top.AsUnits   := ARect.Top;
  311.       AGmRect.Right.AsUnits := ARect.Right;
  312.       AGmRect.Bottom.AsUnits:= ARect.Bottom;
  313.       FPreview.Canvas.Font.Color := clBlack;
  314.       if IsFixedCell(AGrid, ICount, ARow) then
  315.         FPreview.Canvas.Brush.Color := AGrid.FixedColor
  316.       else
  317.         FPreview.Canvas.Brush.Color := AGrid.Color;
  318.       if Assigned(FOnDrawCell) then
  319.         FOnDrawCell(Self, AGrid, ICount, ARow, AGmRect, FPreview.Canvas)
  320.       else
  321.         DefaultDrawCellExt(AGrid, AGmRect, ICount, ARow, FDefaultCellAlign, FDefaultCellVertAlign);
  322.     finally
  323.       AGmRect.Free;
  324.     end;
  325.     Inc(ALeft, ARect.Right-ARect.Left);
  326.   end;
  327.   Inc(ATop, ARect.Bottom-ARect.Top);
  328. end;
  329.  
  330. procedure TGmGridPrint.GridToPage(X, Y, AWidth: Extended; AUnits: TGmMeasurement;
  331.   AGrid: TDrawGrid);
  332. var
  333.   StartXY : TPoint;
  334.   CurrLeft: integer;
  335.   CurrTop : integer;
  336.   ICount  : integer;
  337.   DesiredWidth: integer;
  338.   LastTop,
  339.   LastLeft: integer;
  340. begin
  341.   // draw the string-grid to the TGmPreview...
  342.   if not Assigned(FPreview) then
  343.   begin
  344.     ShowGmError(Self, NO_PREVIEW_ASSIGNED);
  345.     Exit;
  346.   end;
  347.  
  348.   FPreview.MessagesEnabled := False;
  349.  
  350.   StartXY.x := Round(ConvertValue(X, AUnits, GmUnits));
  351.   StartXY.y := Round(ConvertValue(Y, AUnits, GmUnits));
  352.  
  353.   CurrLeft := StartXY.x;
  354.   CurrTop  := StartXY.y;
  355.  
  356.   FColWidths.Clear;
  357.  
  358.   for ICount := 0 to AGrid.ColCount-1 do
  359.     FColWidths.AddColWidth(ICount, Round(ConvertValue(AGrid.ColWidths[ICount], GmPixels, GmUnits)));
  360.  
  361.   FColWidths.Scale := 1;
  362.   if AWidth <> 0 then
  363.   begin
  364.     DesiredWidth := Round(ConvertValue(AWidth, AUnits, GmUnits));
  365.     FColWidths.Scale := DesiredWidth / FColWidths.TotalWidth;
  366.  
  367.     for ICount := 0 to FColWidths.Count-1 do
  368.       FColWidths[ICount].Width := Round(FColWidths[ICount].Width * FColWidths.Scale);
  369.   end;
  370.  
  371.   // draw the grid...
  372.   FPreview.Canvas.Pen.Width := 0;
  373.   for ICount := 0 to AGrid.RowCount-1 do
  374.   begin
  375.     LastTop := CurrTop;
  376.     LastLeft := CurrLeft;
  377.     DrawGridRow(ICount, AGrid, CurrLeft, CurrTop);
  378.  
  379.     if ICount < (AGrid.RowCount-1) then
  380.     begin
  381.       with FPreview do
  382.       if ((CurrTop + ConvertValue(AGrid.RowHeights[ICount+1], GmPixels, GmUnits)) >
  383.          (PageHeight.AsUnits - FBottomMargin.AsUnits)) then
  384.       begin
  385.         DrawBottomLine(ICount, AGrid, LastLeft, LastTop);
  386.         FPreview.NewPage;
  387.         CurrTop := StartXY.Y;
  388.         FTopMargin.AsUnits := CurrTop;
  389.         if Assigned(FOnGridNewPage) then FOnGridNewPage(Self, FTopMargin, FBottomMargin);
  390.  
  391.         CurrTop := FTopMargin.AsUnits;
  392.         if (gmFixedRowPerPage in FGridOptions) then
  393.           DrawGridRow(0, AGrid, CurrLeft, CurrTop)
  394.         else
  395.           DrawTopLine(ICount, AGrid, CurrLeft, CurrTop);
  396.       end;
  397.     end;
  398.   end;
  399.   FPreview.MessagesEnabled := True;
  400.   if FPreview.MessagesEnabled then
  401.     FPreview.UpdatePreview;
  402. end;
  403.  
  404. procedure TGmGridPrint.SetPreview(const Value: TGmPreview);
  405. begin
  406.   FPreview := Value;
  407. end;
  408.  
  409. end.
  410.